home *** CD-ROM | disk | FTP | other *** search
/ Amiga Games: Greatest Hits 1996 / Amiga Games: Greatest Hits 1996.iso / archive / spiele / publicdomain / ls-tron3.1.lha / LS-Tron3.1 / LS-Tron.p < prev    next >
Text File  |  1996-04-30  |  31KB  |  1,046 lines
  1. PROGRAM LS_Tron;
  2.  
  3. {$I "LS-Tron.i" }
  4.  
  5. CONST Version  = "$VER: LS-Tron 3.1 (30.04.96)";
  6.       Ver      = "v 3.1";
  7.       Datum    = "30.04.1996";
  8.       pi       = 3.141592653589793238462643;
  9.  
  10.       maxPlay  =   6; { Maximale Spieleranzahl }
  11.       maximum  = 500;
  12.  
  13. {$I "LS-Tron-Types.i" }
  14. {$I "LS-Tron-Const.i" }
  15.  
  16. VAR MyScreen    : ScreenPtr;
  17.     MyWindow    : WindowPtr;       { System Kram...                     }
  18.     MyRastPort  : RastPortPtr;
  19.     MyProcess   : ProcessPtr;
  20.     RWindow     : WindowPtr;
  21.     GameScreen  : ScreenPtr;
  22.     GameWindow  : WindowPtr;
  23.     GameRP      : RastPortPtr;
  24.     normFont    : TextFontPtr;     { Ein Font                           }
  25.     MyModule    : MMD0Ptr;         { ein MED-Modul                      }
  26.     MyWBMessage : WBStartupPtr;    { Workbenchmessage                   }
  27.     TitelWindow : WindowPtr;       { Für Titelbild                      }
  28.     TitelScreen : ScreenPtr;       {  "      "                          }
  29.  
  30.     NormColours,black : ColourArray;
  31.     Backcolours       : BackArray;
  32.     Ende        : BOOLEAN;         { ???                                }
  33.     TBase       : TronBasePtr;
  34.     MouseClear  : MouseCArrayPtr;  { Für Mausausblendung beim Spiel     }
  35.     MouseData   : MouseArrayPtr;   { Für eigene Maus                    }
  36.  
  37. FUNCTION WBStart : BOOLEAN; { Wurde das Programm von der WB aus gestartet?}
  38.  
  39.   BEGIN
  40.     IF MyProcess<>NIL THEN WBStart:=(MyProcess^.pr_Tasknum=0)
  41.                       ELSE WBStart:=TRUE; { Falls nicht feststellbar... }
  42.   END;
  43.  
  44. PROCEDURE DelMouse(aWindow : WindowPtr); { Mauszeiger unsichtbar machen }
  45.  
  46.   BEGIN
  47.     ClearPointer(aWindow);
  48.     SetPointer(aWindow,MouseClear,1,16,-2,-2);
  49.   END;
  50.  
  51. PROCEDURE ViewMouse(aWindow : WindowPtr); { Mauszeiger darstellen }
  52.  
  53.   BEGIN
  54.     ClearPointer(aWindow);
  55.     SetPointer(aWindow,MouseData,12,16,-2,0);
  56.   END; { fön nich' ?!? }
  57.  
  58. FUNCTION Length(s : STRING) : SHORT; { Länge eines Strings in Pixeln }
  59.  
  60.   BEGIN
  61.     Length:=TextLength(MyRastPort,s,strLen(s));
  62.   END;
  63.  
  64. FUNCTION Sprache : BYTE;
  65.  
  66.   BEGIN
  67.     CASE ORD(TBase^.Sprache) OF
  68.       68 : Sprache:=Deutsch;
  69.       69 : Sprache:=English;
  70.      ELSE  Sprache:=English;
  71.     END;
  72.   END;
  73.  
  74. PROCEDURE CloseAll; { Alles schließen }
  75.  
  76.   PROCEDURE SetColoursDown; { Farben schwärzen }
  77.  
  78.     VAR MyColours : ColourArray;
  79.         Hilfe     : BYTE;
  80.  
  81.     BEGIN
  82.       CopyMem(ADR(NormColours),ADR(MyColours),SIZEOF(ColourArray));
  83.  
  84.       WHILE mycolours[1].r>0 DO
  85.         BEGIN
  86.           FOR Hilfe:=0 TO 19 DO
  87.             BEGIN
  88.               SetRGB4(ADR(MyScreen^.SViewPort),hilfe,
  89.                                  MyColours[hilfe].r,
  90.                                  MyColours[hilfe].g,
  91.                                  MyColours[hilfe].b);
  92.  
  93.             WITH mycolours[hilfe] DO
  94.               BEGIN
  95.                 IF r>0 THEN r:=r-1;
  96.                 IF g>0 THEN g:=g-1;
  97.                 IF b>0 THEN b:=b-1;
  98.               END;
  99.             END;
  100.         END;
  101.     END;
  102.  
  103.   PROCEDURE FreeTBase;
  104.  
  105.     VAR zahl : BYTE;
  106.  
  107.     BEGIN
  108.       WITH TBase^ DO
  109.         BEGIN
  110.           FreeString(TronDir);
  111.           FreeString(MyMaze.MazeDir);
  112.           FreeString(MyMaze.MazeName);
  113.           WITH MyMaze DO
  114.             IF Linien<>NIL THEN FreeMem(Linien,SizeOf(Linie)*LineNum);
  115.           FOR zahl:=1 TO maxplay DO
  116.             FreeString(players[zahl].Name);
  117.         END;
  118.  
  119.       Dispose(TBase);
  120.     END;
  121.  
  122.   BEGIN { Was ist denn so alles offen }
  123.     IF TBase^.Sound THEN DimOffPlayer(20);
  124.  
  125.     FreeTBase;
  126.  
  127.     IF MyScreen     <>NIL THEN SetColoursDown;
  128.     IF MyModule     <>NIL THEN Delay(50);
  129.  
  130.     IF GameWindow   <>NIL THEN BEGIN
  131.                                  ClearPointer (GameWindow);
  132.                                  MyCloseWindow(GameWindow);
  133.                                END;
  134.     IF MyWindow     <>NIL THEN BEGIN
  135.                                  ClearPointer (MyWindow  );
  136.                                  MyCloseWindow(MyWindow  );
  137.                                  myProcess^.pr_WindowPtr:=RWindow;
  138.                                END;
  139.  
  140.     IF MouseData    <>NIL THEN FreeMem(MouseData ,SizeOf(mousearray ));
  141.     IF MouseClear   <>NIL THEN FreeMem(MouseClear,SizeOf(mouseCarray));
  142.  
  143.     IF MyScreen     <>NIL THEN CloseScreen(MyScreen  );
  144.     IF GameScreen   <>NIL THEN CloseScreen(GameScreen);
  145.  
  146.     IF normFont     <>NIL THEN CloseFont(NormFont);
  147.  
  148.     IF TitelWindow  <>NIL THEN MyCloseWindow(TitelWindow);
  149.     IF TitelScreen  <>NIL THEN CloseScreen(TitelScreen);
  150.  
  151.     IF gfxBase      <>NIL THEN CloseLibrary(LibraryPtr(gfxBase      ));
  152.     IF Rtbase       <>NIL THEN CloseLibrary(LibraryPtr(rtbase       ));
  153.     IF diskfontbase <>NIL THEN CloseLibrary(LibraryPtr(diskfontbase ));
  154.  
  155.     IF MyModule     <>NIL THEN BEGIN
  156.                                  FreePlayer;
  157.                                  UnloadModule(MyModule);
  158.                                END;
  159.     IF MedPlayerBase<>NIL THEN CloseLibrary(LibraryPtr(MEDPlayerBase));
  160.  
  161.   END; { Nilismus Error... }
  162.  
  163. PROCEDURE CleanExit(error : INTEGER); { Fehler ausgeben und Tschüß }
  164.  
  165.   PROCEDURE WriteError(Err : INTEGER);
  166.  
  167.     BEGIN
  168.       WRITE("\n");
  169.       CASE Err OF
  170.         4 : WRITE("Couldn`t find own processpointer!");
  171.         5 : WRITE("Couldn`t find the LS-Tron sourcedirectory!");
  172.         6 : WRITE("There was no WBMessage!");
  173.         7 : WRITE("Couldn`t read the configurationfile!");
  174.        ELSE CASE Sprache OF
  175.               Deutsch : CASE Err OF
  176.                            1 : WRITE("Konnte Screen nicht öffnen!");
  177.                            2 : WRITE("Konnte Fenster nicht öffnen!");
  178.                            3 : WRITE("Nicht genug Chip-Mem vorhanden!");
  179.                            8 : WRITE("\nDateiliste nicht vollständig!");
  180.                            9 : WRITE("Es konnten nicht alle Screens und Fenster geöffnet werden!");
  181.                           10 : WRITE("Nicht genug Speicher vorhanden!");
  182.                           21 : WRITE("Konnte die Grafics.library nicht öffnen!");
  183.                           22 : WRITE("Konnte die Reqtools.library nicht öffnen!");
  184.                           23 : WRITE("Konnte die Diskfont.library nicht öffnen!");
  185.                           30 : WRITE("Konnte den LS.font nicht öffnen!");
  186.                           50 : WRITE("?");
  187.                           51 : WRITE("Nicht genug Speicher!");
  188.                           52 : WRITE("Konnte Screen nicht öffnen!");
  189.                           53 : WRITE("Konnte Fenster nicht öffnen!");
  190.                           54 : WRITE("Konnte Datei nicht öffnen!");
  191.                           55 : WRITE("Das Titelbild enthält ein falsches IFF-Format!");
  192.                           56 : WRITE("Schreib-/Lese-Fehler!");
  193.                          ELSE WRITE("Unbekannte Fehlernummer : ",err);
  194.                         END;
  195.              ELSE CASE Err OF
  196.                      1 : WRITE("Couldn't open screen!");
  197.                      2 : WRITE("Couldn't open window!");
  198.                      3 : WRITE("Not enough Chip-Mem!");
  199.                      8 : WRITE("\nThere are files missing!");
  200.                      9 : WRITE("Couldn't open all screens and windows!");
  201.                     10 : WRITE("Not enough memory!");
  202.                     21 : WRITE("Couldn't open grafics.library!");
  203.                     22 : WRITE("Couldn't open reqtools.library!");
  204.                     23 : WRITE("Couldn't open diskfont.library!");
  205.                     30 : WRITE("Couldn't open LS.font!");
  206.                     50 : WRITE("?");
  207.                     51 : WRITE("Not enough memory!");
  208.                     52 : WRITE("Couldn't open screen!");
  209.                     53 : WRITE("Couldn't open window!");
  210.                     54 : WRITE("Couldn't open file!");
  211.                     55 : WRITE("The title-picture consists of a wrong IFF-format!");
  212.                     56 : WRITE("Read-/Write-Error!");
  213.                    ELSE WRITE("Unknown errornumber : ",Err);
  214.                   END;
  215.             END;
  216.       END;
  217.  
  218.       WRITE("\n\n p");
  219.     END;
  220.  
  221.   BEGIN
  222.     CloseAll;
  223.     WriteError(error);
  224.     IF MyProcess<>NIL THEN BEGIN
  225.                              IF WBStart THEN Delay(250);
  226.                            END
  227.                       ELSE Delay(250);
  228.     EXIT(0);
  229.   END;
  230.  
  231. PROCEDURE SetSColours; { Farben einstellen }
  232.  
  233.   VAR MyColours, Colours : ColourArray;
  234.       Hilfe,help : BYTE;
  235.  
  236.   BEGIN
  237.     CopyMem(ADR(Black      ),ADR(  Colours),SIZEOF(ColourArray));
  238.     CopyMem(ADR(NormColours),ADR(MyColours),SizeOF(ColourArray));
  239.     FOR help:=0 TO 15 DO
  240.       BEGIN
  241.         FOR Hilfe:=0 TO 19 DO
  242.           BEGIN
  243.             SetRGB4(ADDRESS(MyScreen^.SViewPort),hilfe,
  244.                                 Colours[hilfe].r,
  245.                                 Colours[hilfe].g,
  246.                                 Colours[hilfe].b);
  247.  
  248.             IF 14-help<mycolours[hilfe].r THEN { Farbwerte solange erhöhen,}
  249.                inc(colours[hilfe].r);
  250.             IF 14-help<mycolours[hilfe].g THEN { bis der richtige Wert     }
  251.                inc(colours[hilfe].g);
  252.             IF 14-help<mycolours[hilfe].b THEN { erreicht ist.             }
  253.                inc(colours[hilfe].b);
  254.           END;
  255.       END;
  256.   END;
  257.  
  258. PROCEDURE Sprache_Hauptmenue;
  259.  
  260.   BEGIN
  261.     IF ORD(TBase^.Sprache)=68 THEN
  262.        BEGIN
  263.          Print(MyRastPort,281,113,GermanMain[1],1);
  264.          Print(MyRastPort,282,133,GermanMain[2],1);
  265.          Print(MyRastPort,269,153,GermanMain[3],1);
  266.          Print(MyRastPort,264,173,GermanMain[4],1);
  267.          Print(MyRastPort,264,193,GermanMain[5],1);
  268.          Print(MyRastPort,283,213,GermanMain[6],8);
  269.        END
  270.       ELSE
  271.        BEGIN
  272.          Print(MyRastPort,281,113,EnglishMain[1],1);
  273.          Print(MyRastPort,282,133,EnglishMain[2],1);
  274.          Print(MyRastPort,269,153,EnglishMain[3],1);
  275.          Print(MyRastPort,263,173,EnglishMain[4],1);
  276.          Print(MyRastPort,263,193,EnglishMain[5],1);
  277.          Print(MyRastPort,283,213,EnglishMain[6],8);
  278.        END;
  279.   END;
  280.  
  281. PROCEDURE OpenAll; { Alles öffnen }
  282.  
  283.   PROCEDURE GetProcessPtr; { Pointer auf eigenes Programm holen }
  284.  
  285.     BEGIN
  286.       MyProcess:=ProcessPtr(FindTask(NIL)); { Prozessfenster umstellen }
  287.       IF myProcess=NIL THEN CleanExit(Error_No_Process);
  288.     END;
  289.  
  290.   PROCEDURE GetMyDir;
  291.  
  292.     FUNCTION SearchTree(Kind : BPTR;VAR DirName : STRING) : BOOLEAN;
  293.  
  294.       { Pfadnamen rekursiv bis zum Devicenamen ermitteln }
  295.  
  296.       VAR Elter : BPTR;
  297.           Ok    : BOOLEAN;
  298.           MyFib : FileInfoBlockPtr;
  299.  
  300.       BEGIN
  301.         ok:=TRUE;
  302.  
  303.         MyFib:=NIL;
  304.         New(MyFib);
  305.         IF MyFib=NIL THEN Ok:=FALSE;
  306.  
  307.         IF Ok THEN
  308.            BEGIN
  309.              Elter:=NIL;
  310.              Elter:=ParentDir(Kind);
  311.              IF Elter<>NIL THEN Ok:=SearchTree(Elter,DirName);
  312.  
  313.              IF Ok THEN
  314.                 BEGIN
  315.                   Ok:=Examine(Kind,MyFib);
  316.                   IF Ok THEN BEGIN
  317.                                StrCat(DirName,ADR(MyFib^.fib_FileName));
  318.                                IF Elter=NIL THEN StrCat(DirName,":")
  319.                                             ELSE StrCat(DirName,"/");
  320.                              END;
  321.                 END;
  322.            END;
  323.  
  324.         IF MyFib<>NIL THEN Dispose(MyFib);
  325.         IF Elter<>NIL THEN Unlock(Elter);
  326.  
  327.         SearchTree:=Ok;
  328.       END;
  329.  
  330.     PROCEDURE CliStart;
  331.  
  332.      { Verzeichnissnamen ausgehend von der Dosstruktur ermitteln }
  333.  
  334.       BEGIN
  335.         IF NOT SearchTree(MyProcess^.pr_CurrentDir,TBase^.TronDir) THEN
  336.            CleanExit(Error_No_Sourcedir);
  337.       END;
  338.  
  339.     PROCEDURE Workbenchstart;
  340.  
  341.      { Ein dickes Danke an Wurzelsepp für diesen Code }
  342.  
  343.       BEGIN
  344.         IF MyWBMessage=NIL THEN CleanExit(Error_No_WBMessage);
  345.  
  346.         WITH MyWBMessage^.sm_Arglist^[1] DO
  347.           IF NOT SearchTree(wa_lock,TBase^.TronDir) THEN
  348.              CleanExit(Error_No_Sourcedir);
  349.       END;
  350.  
  351.     BEGIN
  352.       MyWBMessage:=GetStartupMsg;
  353.  
  354.       IF WBStart THEN WorkbenchStart
  355.                  ELSE CliStart;
  356.  
  357.       StrCpy(TBase^.MyMaze.MazeDir,TBase^.TronDir);
  358.     END;
  359.  
  360.   PROCEDURE Load_Options; { engl: Load = Laden , Option = Option }
  361.  
  362.     VAR farbe      : BYTE;
  363.         CFile      : TEXT;
  364.         ConfigName : STRING;
  365.  
  366.     PROCEDURE Opt_Exit;
  367.  
  368.       BEGIN
  369.        {$I-}
  370.         Close(CFile);
  371.        {$I+}
  372.  
  373.         FreeString(ConfigName);
  374.  
  375.         CleanExit(Error_in_Configfile);
  376.       END;
  377.  
  378.     PROCEDURE Check_Options;
  379.  
  380.       BEGIN
  381.         WITH TBase^ DO
  382.           BEGIN
  383.             IF (max_length MOD 50<>0) THEN
  384.                max_length:=(Max_length DIV 50)*50;
  385.             IF Max_Length<0   THEN Max_Length:=0;
  386.             IF Max_Length>500 THEN Max_Length:=500;
  387.  
  388.             IF Player<2 THEN player:=2;
  389.             IF player>6 THEN player:=6;
  390.  
  391.             IF speed<0 THEN speed:=0;
  392.             IF speed>5 THEN speed:=5;
  393.  
  394.             IF level<0 THEN level:=0;
  395.             IF level>5 THEN level:=5;
  396.  
  397.             IF human>player THEN human:=player;
  398.             IF Human<0      THEN human:=0;
  399.  
  400.             IF Backcolour<1 THEN Backcolour:=0;
  401.             IF backcolour>4 THEN Backcolour:=3;
  402.           END;
  403.       END;
  404.  
  405.     VAR Zeile : STRING;
  406.  
  407.     BEGIN
  408.       ConfigName:=ALLOCSTRING(255);
  409.       StrCpy(ConfigName,TBase^.TronDir);
  410.       StrCat(ConfigName,"LS-Tron.config");
  411.  
  412.      {$I-}
  413.       Reset(CFile,ConfigName); { Konfig-Datei suchen }
  414.       IF IoResult<>0 THEN
  415.          Opt_Exit;
  416.  
  417.       WITH TBase^ DO
  418.         BEGIN
  419.           Zeile:=AllocString(255);
  420.           READLN(CFile,zeile);
  421.           Sprache:=Zeile[0];
  422.           FreeString(Zeile);
  423.           IF IOResult<>0 THEN Opt_Exit;
  424.  
  425.           Sprache:=ToUpper(Sprache);
  426.           IF NOT IsAlpha(Sprache) THEN Opt_Exit;
  427.  
  428.           READLN(CFile,max_length);
  429.           IF IOResult<>0 THEN Opt_Exit;
  430.  
  431.           READLN(CFile,player);
  432.           IF IOResult<>0 THEN Opt_Exit;
  433.  
  434.           READLN(CFile,speed);
  435.           IF IOResult<>0 THEN Opt_Exit;
  436.  
  437.           READLN(CFile,level);
  438.           IF IOResult<>0 THEN Opt_Exit;
  439.  
  440.           READLN(CFile,human);
  441.           IF IOResult<>0 THEN Opt_Exit;
  442.  
  443.           READLN(CFile,Backcolour);
  444.           IF IOResult<>0 THEN Opt_Exit;
  445.         END;
  446.  
  447.       FOR farbe:=0 TO 19 DO         { Alle Farben laden (incl. Mausfarben) }
  448.         WITH normcolours[farbe] DO
  449.           BEGIN
  450.             READLN(CFile,r);
  451.             IF IoResult<>0 THEN Opt_Exit;
  452.             READLN(CFile,g);
  453.             IF IoResult<>0 THEN Opt_Exit;
  454.             READLN(CFile,b);
  455.             IF IoResult<>0 THEN Opt_Exit;
  456.           END;
  457.  
  458.       FOR farbe:=1 TO 4 DO              { Hintergrundfarben laden }
  459.         WITH backcolours[farbe] DO
  460.           BEGIN
  461.             READLN(CFile,r);
  462.             IF IoResult<>0 THEN Opt_Exit;
  463.             READLN(CFile,g);
  464.             IF IoResult<>0 THEN Opt_Exit;
  465.             READLN(CFile,b);
  466.             IF IoResult<>0 THEN Opt_Exit;
  467.           END;
  468.  
  469.       Close(CFile);
  470.      {$I+}
  471.  
  472.       FreeString(ConfigName);
  473.  
  474.       Check_Options;
  475.     END;
  476.  
  477.   PROCEDURE InitMouse; { Mausdaten bereitmachen & Speicher organisieren }
  478.  
  479.     VAR zahl : BYTE;
  480.  
  481.     BEGIN
  482.       MouseClear:=ADDRESS(ALLOCMEM(SizeOf(MouseCArray),MEMF_CHIP));
  483.       IF MouseClear=NIL THEN CleanExit(Error_No_Chipmem);
  484.  
  485.       FOR zahl:=0 TO 5 DO MouseClear^[zahl]:=0;
  486.  
  487.       MouseData:=ADDRESS(ALLOCMEM(SizeOf(MouseArray),MEMF_CHIP));
  488.       IF MouseData=NIL THEN CleanExit(Error_No_Chipmem);
  489.       CopyMem(ADR(MausDaten),ADDRESS(MouseData),SIZEOF(MouseArray));
  490.     END;
  491.  
  492.   PROCEDURE SetBlackColours; { Farben:=schwarz; }
  493.  
  494.     VAR Hilfe : INTEGER;
  495.  
  496.     BEGIN
  497.       FOR Hilfe:=0 TO 19 DO
  498.         BEGIN
  499.           SetRGB4(ADDRESS(MyScreen^.SViewPort),hilfe,0,0,0);
  500.         END;
  501.     END;
  502.  
  503.   PROCEDURE PlaySound; { ? }
  504.  
  505.     VAR SongName : STRING;
  506.         zaehler  : BYTE;
  507.  
  508.     BEGIN
  509.       TBase^.Sound:=FALSE;
  510.  
  511.       SongName:=ALLOCSTRING(255);               { Songnamen herausfinden }
  512.       zaehler:=1;
  513.       REPEAT
  514.         GetParam(zaehler,SongName);             { Kann User wählen...    }
  515.         zaehler:=zaehler+1;
  516.       UNTIL (Songname^=CHR(0)) OR StrnIEq(SongName,"-l",2);
  517.  
  518.       IF SongName^=CHR(0) THEN
  519.          BEGIN
  520.            StrCpy(SongName,TBase^.TronDir);
  521.            StrCat(SongName,"Med.LS-Tron");
  522.          END
  523.         ELSE
  524.          BEGIN
  525.            zaehler:=-1;
  526.            REPEAT
  527.              inc(zaehler);
  528.              SongName[zaehler]:=SongName[zaehler+2];
  529.            UNTIL SongName[zaehler]=CHR(0);
  530.          END;
  531.  
  532.       IF GetPlayer(0)=0 THEN
  533.          BEGIN
  534.            MyModule:=LoadModule(SongName); { Modul laden }
  535.  
  536.            IF MyModule<>NIL THEN            { Modul abspielen }
  537.               BEGIN
  538.                 PlayModule(MyModule);
  539.                 TBase^.Sound:=TRUE;
  540.               END
  541.              ELSE
  542.               BEGIN
  543.                 FreePlayer;
  544.                 CloseLibrary(LibraryPtr(MedPlayerBase));
  545.                 MedPlayerBase:=NIL;
  546.               END;
  547.          END
  548.         ELSE
  549.          BEGIN
  550.            CloseLibrary(LibraryPtr(MedPlayerBase));
  551.            MedPlayerBase:=NIL;
  552.          END;
  553.  
  554.       FreeString(SongName);
  555.     END;
  556.  
  557.   PROCEDURE DrawText; { ? }
  558.  
  559.     PROCEDURE EmptyBox(PosX,PosY : SHORT);
  560.  
  561.       CONST x0    =   0;
  562.             y0    =   1;
  563.             seite =   8;
  564.  
  565.       VAR MyX,MyY : SHORT;
  566.  
  567.       BEGIN
  568.         MyX:=x0+seite*2*PosX;
  569.         MyY:=y0+seite*  PosY;
  570.  
  571.         SetAPen(MyRastPort,schwarz);
  572.         Line(MyRastPort,MyX          ,MyY+seite-1,
  573.                         MyX+2*seite-1,MyY+seite-1);
  574.         Draw(MyRastPort,MyX+2*seite-1,MyY        );
  575.         Line(MyRastPort,MyX+2*seite-2,MyY+seite-1,
  576.                         MyX+2*seite-2,MyY        );
  577.  
  578.         SetAPen(MyRastPort,mgrau);
  579.         Line(MyRastPort,MyX          ,MyY+seite-1,
  580.                         MyX        +1,MyY        );
  581.         Draw(MyRastPort,MyX+2*seite-2,MyY        );
  582.         Line(MyRastPort,MyX        +1,MyY+seite-2,
  583.                         MyX        +1,MyY        );
  584.       END;
  585.  
  586.     PROCEDURE MiniBox(PosX,PosY,c : SHORT);
  587.  
  588.       CONST x0    =  80;
  589.             y0    =   1;
  590.             seite =   8;
  591.  
  592.       VAR MyX,MyY : SHORT;
  593.  
  594.       BEGIN
  595.         IF c=11 THEN c:=0;
  596.  
  597.         MyX:=x0+seite*2*PosX;
  598.         MyY:=y0+seite*  PosY;
  599.  
  600.         SetAPen(MyRastPort,schwarz);
  601.         Line(MyRastPort,MyX          ,MyY+seite-1,
  602.                         MyX+2*seite-1,MyY+seite-1);
  603.         Line(MyRastPort,MyX+2*seite-1,MyY+seite-1,
  604.                         MyX+2*seite-1,MyY        );
  605.         Line(MyRastPort,MyX+2*seite-2,MyY+seite-1,
  606.                         MyX+2*seite-2,MyY        );
  607.  
  608.         SetAPen(MyRastPort,mgrau);
  609.         Line(MyRastPort,MyX          ,MyY+seite-1,
  610.                         MyX          ,MyY        );
  611.         Line(MyRastPort,MyX        +1,MyY+seite-2,
  612.                         MyX        +1,MyY        );
  613.         Line(MyRastPort,MyX        +1,MyY        ,
  614.                         MyX+2*seite-2,MyY        );
  615.  
  616.         SetAPen(MyRastPort,c);
  617.         RectFill(MyRastPort,MyX+2,MyY+1,MyX+2*seite-3,MyY+seite-2);
  618.       END;
  619.  
  620.     VAR MyData : ADDRESS;
  621.         x,y    : SHORT;
  622.  
  623.     BEGIN
  624.       SetAPen(MyRastPort,8);
  625.       SetBPen(MyRastPort,0);
  626.  
  627.       FOR x:=0 TO 39 DO
  628.         FOR y:=0 TO 29 DO
  629.           IF (x<14) OR (x>22) OR
  630.              (y<12) OR (y>27) THEN EmptyBox(x,y);
  631.  
  632.       FOR x:=1 TO 28 DO
  633.           FOR y:=1 TO 9 DO                   { "LS-Tron" schreiben }
  634.               MiniBox(x,y,LSScript[x,10-y]);
  635.  
  636.       DrawBox(MyRastPort,225,97,366,224);
  637.       DrawBox(MyRastPort,224,97,367,224);
  638.       SetFont(MyRastPort,NormFont);
  639.  
  640.       SetAPen(MyRastPort,1);
  641.       Line(MyRastPort,0,0,639,0);
  642.  
  643.       Sprache_Hauptmenue;
  644.     END;
  645.  
  646.   PROCEDURE InitGadgets; { Gadgets vorbereiten }
  647.  
  648.     BEGIN
  649.       Bora2.xy:=ADR(Koord2);
  650.       Bora1.xy:=ADR(Koord1);
  651.       Bora1.NextBorder:=ADR(Bora2);
  652.  
  653.       Borb2.xy:=ADR(Koord4);
  654.       Borb1.xy:=ADR(Koord3);
  655.       Borb1.NextBorder:=ADR(Borb2);
  656.  
  657.       SetGadget(ADR(Gad10),NIL       ,ADR(Bora1),ADR(Borb1),NIL);
  658.       SetGadget(ADR(Gad05),ADR(Gad10),ADR(Bora1),ADR(Borb1),NIL);
  659.       SetGadget(ADR(Gad04),ADR(Gad05),ADR(Bora1),ADR(Borb1),NIL);
  660.       SetGadget(ADR(Gad03),ADR(Gad04),ADR(Bora1),ADR(Borb1),NIL);
  661.       SetGadget(ADR(Gad02),ADR(Gad03),ADR(Bora1),ADR(Borb1),NIL);
  662.       SetGadget(ADR(Gad01),ADR(Gad02),ADR(Bora1),ADR(Borb1),NIL);
  663.     END;
  664.  
  665.          { Fenster & Screens : nervig wie notwendig... }
  666.  
  667.   CONST MyNewWindow : NewWindow = (0,10,640,246,0,0,RawKey_f+GadgetDown_f+
  668.                                    Gadgetup_f,SMART_Refresh+RMBTrap+
  669.                                    BORDERLESS,NIL,NIL,NIL,NIL,NIL,
  670.                                    640,246,640,246,CUSTOMSCREEN_F);
  671.  
  672.         MyNewScreen : NewScreen = (0,0,640,256,4,8,1,HIRES,CUSTOMSCREEN_F+
  673.                                    ScreenBehind_F,NIL,
  674.                                    "LS-Tron - Programmbildschirm",
  675.                                    NIL,NIL);
  676.  
  677.   PROCEDURE SetAllNil; { Für Fehlerabfang }
  678.  
  679.     BEGIN
  680.       MyScreen     :=NIL;
  681.       GameScreen   :=NIL;
  682.       TitelScreen  :=NIL;
  683.       MyWindow     :=NIL;
  684.       gameWindow   :=NIL;
  685.       TitelWindow  :=NIL;
  686.       GfxBase      :=NIL;
  687.       diskfontbase :=NIL;
  688.       normFont     :=NIL;
  689.       medplayerbase:=NIL;
  690.       RTBase       :=NIL;
  691.       MouseData    :=NIL;
  692.       MouseClear   :=NIL;
  693.       MyWBMessage  :=NIL;
  694.       MyProcess    :=NIL;
  695.     END;
  696.  
  697.   PROCEDURE AllocTBase; { Speicher für TBase holen...WICHTIG!!! }
  698.  
  699.     VAR zahl : BYTE;
  700.  
  701.     BEGIN
  702.       New(TBase);
  703.       WITH TBase^ DO
  704.         BEGIN
  705.           TronDir:=ALLOCSTRING(255);
  706.           MyMaze.MazeDir:=ALLOCSTRING(255);
  707.           MyMaze.MazeName:=ALLOCSTRING(255);
  708.           MyMaze.linien:=NIL;
  709.           MyMaze.LineNum:=0;
  710.           FOR zahl:=1 TO maxplay DO
  711.               BEGIN
  712.                 players[zahl].name:=ALLOCSTRING(20);
  713.                 StrCpy(Players[zahl].name,"Spieler ");
  714.                 AddString(Players[zahl].name,zahl);
  715.               END;
  716.         END;
  717.     END;
  718.  
  719.   PROCEDURE OpenLibs; { Libraries öffnen... }
  720.  
  721.     BEGIN
  722.       gfxBase:=Openlibrary("graphics.library",0);
  723.       IF gfxBase=NIL THEN CleanExit(Error_No_Grafics);
  724.  
  725.       rtbase:=ADDRESS(OpenLibrary("reqtools.library",38));
  726.       IF rtbase=NIL THEN CleanExit(Error_No_Reqtools);
  727.  
  728.       MEDPlayerBase:=OpenLibrary(medname,0);
  729.       IF medplayerbase<>NIL THEN PlaySound;
  730.  
  731.       diskfontbase:=OpenLibrary("diskfont.library",0);
  732.       IF Diskfontbase=NIL THEN CleanExit(Error_No_Diskfont);
  733.     END;
  734.  
  735.   FUNCTION OpenDisplay : BOOLEAN; { Screens und Windows öffnen, }
  736.                                   { Farben einstellen           }
  737.                                   { usw.                        }
  738.  
  739.     VAR ok : BOOLEAN;
  740.  
  741.     BEGIN
  742.       Ok:=FALSE;
  743.  
  744.       myNewScreen.font:=ADR(NFont);
  745.       myScreen:=OpenScreen(ADR(MyNewScreen));
  746.       IF MyScreen<>NIL THEN
  747.          BEGIN
  748.            SetBlackColours;
  749.  
  750.            InitGadgets;
  751.            MyNewWindow.Screen:=MyScreen;
  752.            MyNewWindow.FirstGadget:=ADR(Gad01);
  753.            MyWindow:=OpenWindow(ADR(MyNewWindow));
  754.            IF MyWindow<>NIL THEN
  755.               BEGIN
  756.                 MyRastPort:=ADDRESS(MyWindow^.RPort);
  757.  
  758.                 DelMouse(MyWindow);
  759.  
  760.                 DrawText;
  761.  
  762.                 Ok:=TRUE;
  763.               END;
  764.          END;
  765.  
  766.       IF NOT Ok THEN
  767.          BEGIN
  768.            IF MyWindow    <>NIL THEN MyCloseWindow(MyWindow  );
  769.            IF MyScreen    <>NIL THEN CloseScreen  (MyScreen  );
  770.  
  771.            MyWindow  :=NIL;
  772.            MyScreen  :=NIL;
  773.          END;
  774.  
  775.       OpenDisplay:=Ok;
  776.     END;
  777.  
  778.   PROCEDURE SetProcessWindow; { Bezugswindow für Proggie umstellen }
  779.  
  780.     BEGIN
  781.       RWindow:=ADDRESS(MyProcess^.pr_WindowPtr);
  782.       myProcess^.pr_WindowPtr:=MyWindow;
  783.     END;
  784.  
  785.   PROCEDURE OpenLSFont; { Schöneren Zeichensatz laden }
  786.  
  787.     BEGIN
  788.       NormFont:=OpenFont(ADR(NFont));
  789.       IF NormFont=NIL THEN
  790.          BEGIN
  791.            NormFont:=OpenDiskFont(ADR(NFONT));
  792.            IF normFont=NIL THEN CleanExit(Error_No_LS_font);
  793.          END;
  794.     END;
  795.  
  796.   PROCEDURE ClosePic;
  797.  
  798.     BEGIN
  799.       IF WaitPort(TitelWindow^.Userport)=NIL THEN;
  800.  
  801.       MyCloseWindow(TitelWindow);
  802.       CloseScreen(TitelScreen);
  803.  
  804.       TitelWindow:=NIL;
  805.       TitelScreen:=NIL;
  806.     END;
  807.  
  808.   PROCEDURE CheckFiles; { Überprüfen ob alle Dateien noch vorhanden sind }
  809.  
  810.     VAR Didntfindallfiles : BOOLEAN;
  811.  
  812.     FUNCTION FoundFile(Name : STRING) : BOOLEAN; { Nach einer Datei suchen }
  813.  
  814.       VAR MyLock   : ADDRESS;
  815.           Found    : BOOLEAN;
  816.           fileName : STRING;
  817.  
  818.       BEGIN
  819.         FileName:=ALLOCSTRING(255);
  820.  
  821.         StrCpy(FileName,TBase^.TronDir);
  822.         StrCat(FileName,Name);
  823.  
  824.         MyLock:=NIL;
  825.         MyLock:=Lock(FileName,ACCESS_READ);
  826.  
  827.         Found:=(MyLock<>NIL);
  828.  
  829.         Unlock(MyLock);
  830.  
  831.         FreeString(FileName);
  832.  
  833.         foundfile:=Found;
  834.       END;
  835.  
  836.     PROCEDURE NotFound(s : STRING); { Nicht gefunden - FEHLER UND ENDE }
  837.  
  838.       BEGIN
  839.         Didntfindallfiles:=TRUE;
  840.         IF Sprache=Deutsch THEN WRITE("Konnte Datei ",s," nicht finden!\n")
  841.                            ELSE WRITE("Couldn't find file ",s,"!\n");
  842.       END;
  843.  
  844.     BEGIN
  845.       DidntFindAllFiles:=FALSE;
  846.  
  847.       IF NOT FoundFile("Control.i"        ) THEN NotFound("Control.i"     );
  848.       IF NOT FoundFile("Control.i.info"   ) THEN NotFound("Control.i.info");
  849.       IF NOT FoundFile("Extra.i"          ) THEN NotFound("Extra.i"       );
  850.       IF NOT FoundFile("Extra.i.info"     ) THEN NotFound("Extra.i.info"  );
  851.       IF NOT FoundFile("Init.i"           ) THEN NotFound("Init.i"        );
  852.       IF NOT FoundFile("Init.i.info"      ) THEN NotFound("Init.i.info"   );
  853.       IF NOT FoundFile("Installation"     ) THEN NotFound("Installation"  );
  854.       IF NOT FoundFile("Installation.info") THEN NotFound("Installation.info");
  855.       IF NOT FoundFile("Joystick.i"       ) THEN NotFound("Joystick.i"    );
  856.       IF NOT FoundFile("Joystick.i.info"  ) THEN NotFound("Joystick.i.info");
  857.       IF NOT FoundFile("Joystick.mod"     ) THEN NotFound("Joystick.mod"  );
  858.       IF NOT FoundFile("Joystick.mod.info") THEN NotFound("Joystick.mod.info");
  859.       IF NOT FoundFile("Joystick.o"       ) THEN NotFound("Joystick.o"    );
  860.       IF NOT FoundFile("Joystick.o.info"  ) THEN NotFound("Joystick.o.info");
  861.       IF NOT FoundFile("LS-Tron"          ) THEN NotFound("LS-Tron"       );
  862.       IF NOT FoundFile("LS-Tron.config"   ) THEN NotFound("LS-Tron.config");
  863.       IF NOT FoundFile("LS-Tron-Const.i"  ) THEN NotFound("LS-Tron-Const.i");
  864.       IF NOT FoundFile("LS-Tron-Const.i.info") THEN NotFound("LS-Tron-Const.i.info");
  865.       IF NOT FoundFile("LS-Tron.doc"      ) THEN NotFound("LS-Tron.doc"   );
  866.       IF NOT FoundFile("LS-Tron.doc.info" ) THEN NotFound("LS-Tron.doc.info");
  867.       IF NOT FoundFile("LS-Tron.dok"      ) THEN NotFound("LS-Tron.dok"   );
  868.       IF NOT FoundFile("LS-Tron.dok.info" ) THEN NotFound("LS-Tron.dok.info");
  869.       IF NOT FoundFile("LS-Tron.i"        ) THEN NotFound("LS-Tron.i"     );
  870.       IF NOT FoundFile("LS-Tron.i.info"   ) THEN NotFound("LS-Tron.i.info");
  871.       IF NOT FoundFile("LS-Tron.info"     ) THEN NotFound("LS-Tron.info"  );
  872.       IF NOT FoundFile("LS-Tron.mod"      ) THEN NotFound("LS-Tron.mod"   );
  873.       IF NOT FoundFile("LS-Tron.mod.info" ) THEN NotFound("LS-Tron.mod.info");
  874.       IF NOT FoundFile("LS-Tron.o"        ) THEN NotFound("LS-Tron.o"     );
  875.       IF NOT FoundFile("LS-Tron.o.info"   ) THEN NotFound("LS-Tron.o.info");
  876.       IF NOT FoundFile("LS-Tron.p"        ) THEN NotFound("LS-Tron.p"     );
  877.       IF NOT FoundFile("LS-Tron.p.info"   ) THEN NotFound("LS-Tron.p.info");
  878.       IF NOT FoundFile("LS-Tron.Title"    ) THEN NotFound("LS-Tron.Title" );
  879.       IF NOT FoundFile("LS-Tron-Types.i"  ) THEN NotFound("LS-Tron-Types.i");
  880.       IF NOT FoundFile("LS-Tron-Types.i.info") THEN NotFound("LS-Tron-Types.i.info");
  881.       IF NOT FoundFile("Maze.i"           ) THEN NotFound("Maze.i"        );
  882.       IF NOT FoundFile("Maze.i.info"      ) THEN NotFound("Maze.i.info"   );
  883.       IF NOT FoundFile("Mazes"            ) THEN NotFound("Mazes"         );
  884.       IF NOT FoundFile("Mazes.info"       ) THEN NotFound("Mazes.info"    );
  885.       IF NOT FoundFile("Player.i"         ) THEN NotFound("Player.i"      );
  886.       IF NOT FoundFile("Player.i.info"    ) THEN NotFound("Player.i.info" );
  887.  
  888.       IF NOT FoundFile("Mazes/Tron1.maze" ) THEN NotFound("Tron1.maze"    );
  889.       IF NOT FoundFile("Mazes/Tron2.maze" ) THEN NotFound("Tron2.maze"    );
  890.       IF NOT FoundFile("Mazes/Tron3.maze" ) THEN NotFound("Tron3.maze"    );
  891.       IF NOT FoundFile("Mazes/Tron4.maze" ) THEN NotFound("Tron4.maze"    );
  892.       IF NOT FoundFile("Mazes/Fun.maze"   ) THEN NotFound("Fun.maze"      );
  893.  
  894.       IF DidntFindAllFiles THEN
  895.          BEGIN
  896.            Delay(100);
  897.            CleanExit(Error_in_Filelist);
  898.          END;
  899.     END;
  900.  
  901.   PROCEDURE ViewIff(VAR PicScreen : ScreenPtr;VAR PicWindow : WindowPtr);
  902.  
  903.     VAR PicName : STRING;
  904.         Error   : BYTE;
  905.  
  906.     BEGIN
  907.       PicName:=NIL;
  908.       PicName:=ALLOCSTRING(255);
  909.       IF PicName=NIL THEN CleanExit(Error_No_Mem);
  910.  
  911.       StrCpy(PicName,TBase^.TronDir);
  912.       StrCat(PicName,"LS-Tron.Title");
  913.  
  914.       Error:=ReadILBM(picname,PicScreen,PicWindow);
  915.  
  916.       FreeString(picname);
  917.  
  918.       IF Error<>IFFNoErr THEN CleanExit(Error+50);
  919.     END;
  920.  
  921.   PROCEDURE WaitWithIff(VAR PicScreen : ScreenPtr;VAR PicWindow : WindowPtr;
  922.                         VAR ToScreen  : ScreenPtr;VAR ToWindow  : WindowPtr);
  923.  
  924.     BEGIN
  925.       IF WaitPort(PicWindow^.Userport)=NIL THEN;
  926.  
  927.       ScreenToFront(ToScreen);
  928.       ActivateWindow(ToWindow);
  929.  
  930.       MyCloseWindow(PicWindow);
  931.       CloseScreen(PicScreen);
  932.  
  933.       PicWindow:=NIL;
  934.       PicScreen:=NIL;
  935.     END;
  936.  
  937.   FUNCTION Develop : BOOLEAN;
  938.  
  939.     VAR s    : STRING;
  940.         Dev  : BOOLEAN;
  941.         Zahl : INTEGER;
  942.  
  943.     BEGIN
  944.       s:=ALLOCSTRING(255);
  945.       StrCpy(s," ");
  946.       zahl:=1;
  947.       Dev:=FALSE;
  948.  
  949.       WHILE s^<>CHR(0) DO
  950.         BEGIN
  951.           GetParam(zahl,s);
  952.           inc(zahl);
  953.           IF StrIEq(s,"-dev") THEN dev:=TRUE;
  954.         END;
  955.  
  956.       FreeString(s);
  957.       Develop:=Dev;
  958.     END;
  959.  
  960.   BEGIN { Jetzt alles öffnen und überprüfen ob Offen | Keine weitere Doku }
  961.     SetAllNil;
  962.  
  963.     AllocTBase;
  964.  
  965.     GetProcessPtr;
  966.  
  967.     GetMyDir;
  968.  
  969.     Load_Options;
  970.  
  971.     OpenLibs;
  972.  
  973.     InitMouse;
  974.  
  975.     ViewIff(TitelScreen,TitelWindow);
  976.  
  977.     DelMouse(TitelWindow);
  978.  
  979.     IF NOT Develop THEN CheckFiles;
  980.  
  981.     OpenLSFont;
  982.  
  983.     IF OpenDisplay THEN
  984.        BEGIN
  985.          SetProcessWindow;
  986.          ViewMouse(MyWindow);
  987.  
  988.          ClearPointer(TitelWindow);
  989.  
  990.          WaitWithIff(TitelScreen,TitelWindow,MyScreen,Mywindow);
  991.        END
  992.       ELSE
  993.        BEGIN
  994.          ClosePic;
  995.  
  996.          IF NOT OpenDisplay THEN CleanExit(Error_Not_All_Open);
  997.  
  998.          SetProcessWindow;
  999.          ViewMouse(MyWindow);
  1000.        END;
  1001.   END;
  1002.  
  1003. {$I "Player.i" }
  1004. {$I "Init.i"   }
  1005.  
  1006. PROCEDURE Hauptprogramm; { Kurz nich ? }
  1007.  
  1008.   BEGIN
  1009.     WHILE NOT Ende DO
  1010.       BEGIN
  1011.         Play;
  1012.         Init;
  1013.       END;
  1014.   END;
  1015.  
  1016. PROCEDURE Copyright; {???}
  1017.  
  1018.   BEGIN
  1019.     WRITE("LS-Tron ",ver,"\n\n");
  1020.     WRITE("© 1994-1996 by Dennis Müller (",datum,").\n");
  1021.     WRITE("This game is freeware.\n");
  1022.     WRITE("All rights reserved.\n\n");
  1023.   END;
  1024.  
  1025. PROCEDURE KillCursor;
  1026.  
  1027.   BEGIN
  1028.     WRITE(" p");
  1029.   END;
  1030.  
  1031. PROCEDURE ViewCursor;
  1032.  
  1033.   BEGIN
  1034.     WRITE(" p");
  1035.   END;
  1036.  
  1037. BEGIN             { Das eigentliche Hauptprogramm... }
  1038.   KillCursor;
  1039.   Copyright;
  1040.   OpenAll;
  1041.   Init1st;
  1042.   Hauptprogramm;
  1043.   CloseAll;
  1044.   ViewCursor;
  1045. END.
  1046.